home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / planets.src < prev    next >
Text File  |  1991-10-19  |  5KB  |  279 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ PLANETS by Tim Strong
  3. DIR
  4.   PLANETS
  5.     \<< RCLF 'FLG'
  6. STO { { "Merc"
  7.       \<< 1 CONT
  8.       \>> } { "Venu"
  9.       \<< 2 CONT
  10.       \>> } { "Mars"
  11.       \<< 4 CONT
  12.       \>> } { "Jupit"
  13.       \<< 5 CONT
  14.       \>> } { "Satu"
  15.       \<< 6 CONT
  16.       \>> } { "Uran"
  17.       \<< 7 CONT
  18.       \>> } { "Nept"
  19.       \<< 8 CONT
  20.       \>> } { "Plut"
  21.       \<< 9 CONT
  22.       \>> } } TMENU
  23. "Enter date: M DD YYYY
  24.  Select Planet"
  25. PROMPT DUP 'PLDATA'
  26. SWAP GET OBJ\-> DROP
  27. 'PLDATA' 3 GET OBJ\->
  28. 6 DROPN \-> n Tp \Gel \Gw
  29. ec a ic \GW \Gho Vo Te
  30. \Gele \Gwe ece
  31.       \<< 4 FIX \GDd90
  32. 360 365.242191 / *
  33. DUP Tp / NRMANG
  34. 'Np' STO Te /
  35. NRMANG 'Ne' STO Np
  36. \Gel + \Gw - 'Mp' STO
  37. Np 360 \pi / \->NUM ec
  38. * Mp SIN * + \Gel +
  39. NRMANG 'l' STO l \Gw
  40. - 'vp' STO a 1 ec
  41. SQ - * 1 ec vp COS
  42. * + / 'r' STO Ne
  43. \Gele + \Gwe - 'Me' STO
  44. Ne 360 \pi / \->NUM ece
  45. * Me SIN * + \Gele +
  46. NRMANG 'L' STO L \Gwe
  47. - 've' STO 1 ece SQ
  48. - 1 ece ve COS * +
  49. / 'R' STO l \GW - DUP
  50. SIN ic SIN * ASIN
  51. '\165' STO DUP SIN ic
  52. COS * 'y' STO COS
  53. 'x' STO
  54.         IF 'n<3'
  55.         THEN x y
  56. R\->C ARG \GW + 'l' STO
  57. r \165 COS * 'r' STO r
  58. L l - SIN * R r L l
  59. - COS * - / ATAN
  60. 'Ap' STO 180 L Ap +
  61. + NRMANG '\Gl' STO r
  62. \165 TAN \Gl l - SIN * *
  63. R l L - SIN * /
  64. ATAN '\Gb' STO
  65.         ELSE R l L
  66. - SIN * r R l L -
  67. COS * - / ATAN l +
  68. NRMANG '\Gl' STO r \165
  69. TAN \Gl l - SIN * * R
  70. l L - SIN * / ATAN
  71. '\Gb' STO
  72.         END \Gl \Gb 6
  73. CONCO SWAP 15 /
  74.         IF DUP 0 <
  75.         THEN 24 +
  76.         END SWAP
  77. \->DMS '\Gd' STO '\Ga'
  78. STO R SQ r SQ + 2 R
  79. * r * l L - COS * -
  80. \v/ '\Gr' STO \Gho \Gr /
  81. '\Gh' STO \Gl l - COS 1
  82. + 2 / 'F' STO
  83. .138612439306 \Gr *
  84. \->HMS '\Gt' STO 5 r \Gr
  85. * F \v/ / LOG * Vo +
  86. 'm' STO "\Ga= " \Ga
  87. \->STR + "
  88. \Gd= " \Gd
  89. \->STR + + "
  90. \Gr= " \Gr
  91. \->STR + + "
  92. \Gt= " \Gt
  93. \->STR + + "     " {
  94. "Mercury" "Venus"
  95. "" "Mars" "Jupiter"
  96. "Saturn" "Uranus"
  97. "Neptune" "Pluto" }
  98. n GET + + "
  99. \Gh= " \Gh
  100. \->STR + + "
  101. F= " F
  102. \->STR + + "
  103. m= " m
  104. \->STR + + CLLCD 1
  105. DISP 3 FREEZE FLG
  106. STOF { m \Gt F \Gh \Gr \Ga
  107. \Gd \Gb \Gl Ap x y \165 R ve
  108. L Np FLG Me r vp l
  109. Mp Ne } PURGE
  110.       \>>
  111.     \>>
  112.   CONCO
  113.     \<<
  114.       IF DEPTH 3 <
  115.       THEN { {
  116. "AaH\Gd"
  117.         \<< 1 CONT
  118.         \>> } {
  119. "H\GdAa"
  120.         \<< 2 CONT
  121.         \>> } {
  122. "\Ga\GdH\Gd"
  123.         \<< 3 CONT
  124.         \>> } {
  125. "H\Gd\Ga\Gd"
  126.         \<< 4 CONT
  127.         \>> } {
  128. "\Ga\Gd\Gl\Gb"
  129.         \<< 5 CONT
  130.         \>> } {
  131. "\Gl\Gb\Ga\Gd"
  132.         \<< 6 CONT
  133.         \>> } {
  134. "\Ga\Gdlb"
  135.         \<< 7 CONT
  136.         \>> } {
  137. "lb\Ga\Gd"
  138.         \<< 8 CONT
  139.         \>> } } TMENU
  140. CLLCD
  141. "Select Conversion:"
  142. PROMPT
  143.       END \-> \Gm v n
  144.       \<< { A B C D }
  145. n 2 / .5 + FLOOR
  146. GET EVAL
  147.         IF n 8 == n
  148. 6 == OR
  149.         THEN TRN
  150.         END \Gm COS v
  151. COS * \Gm SIN v COS *
  152. v SIN \->V3 * V\-> ASIN
  153. 3 ROLLD R\->C ARG
  154. SWAP 0 MENU
  155.       \>>
  156.     \>>
  157.   DMS\->
  158.     \<< HMS\-> SWAP
  159. HMS\-> SWAP
  160.     \>>
  161.   \->DMS
  162.     \<< \->HMS "DMS"
  163. \->TAG SWAP \->HMS
  164. "DMS" \->TAG SWAP
  165.     \>>
  166.   JULDAY
  167.     \<< \-> m d y
  168.       \<< y 10000 * m
  169. 100 * d + +
  170. 15821015 \>=
  171.         IF 'm\<=2'
  172.         THEN y 1 -
  173. 'y' STO m 12 + 'm'
  174. STO
  175.         END
  176.         IF
  177.         THEN y 100
  178. / IP DUP 4 / IP
  179. SWAP NEG 2 + +
  180.         ELSE 0
  181.         END 365.25
  182. y *
  183.         IF 'y<0'
  184.         THEN .75 -
  185.         END IP
  186. 30.6001 m 1 + * IP
  187. + + d + 1720994.5 +
  188.       \>>
  189.     \>>
  190.   \GDd90
  191.     \<< JULDAY
  192. 2447891.5 -
  193.     \>>
  194.   EPOCH 2000
  195.   A
  196.     \<< \O/ SIN NEG 0 \O/
  197. COS 0 -1 0 \O/ COS 0
  198. \O/ SIN { 3 3 } \->ARRY
  199.     \>>
  200.   B
  201.     \<< LST COS LST
  202. SIN 0 LST SIN LST
  203. COS NEG 0 0 0 1 { 3
  204. 3 } \->ARRY
  205.     \>>
  206.   C
  207.     \<< 1 0 0 0 \Ge COS
  208. \Ge SIN 0 \Ge SIN NEG \Ge
  209. COS { 3 3 } \->ARRY
  210.     \>>
  211.   D
  212. [[ -.0669887 -.8727558 -.4835389 ]
  213.  [ .4927285 -.450347 .7445846 ]
  214.  [ -.8676008 -.1883746 .4601998 ]]
  215.   \Ge
  216.     \<< 1 0 EPOCH
  217. JULDAY 2451545 -
  218. 36525 / \-> T '(
  219. 46.815*T+.0006*T^2-
  220. .00181*T^3)/3600'
  221. NEG 23.439292 +
  222.     \>>
  223.   \O/ 47.0194444444
  224.   CST { PLANETS
  225. CONCO DMS\-> \->DMS
  226. JULDAY \GDd90 EPOCH \O/
  227. \Ge }
  228.   NRMANG
  229.     \<< DUP 360 / IP
  230. 360 * -
  231.       IF DUP 0 <
  232.       THEN 360 +
  233.       END
  234.     \>>
  235.   PLDATA { {
  236. .240852 60.750646
  237. 77.299833 .205633
  238. .387099 7.00454
  239. 48.21274 6.74 -.42
  240. } { .615211
  241. 88.455855
  242. 131.430236 .006778
  243. .723332 3.394535
  244. 76.58982 16.92 -4.4
  245. } { 1.00004
  246. 99.403308
  247. 102.768413 .016713
  248. 1 0 0 0 0 } {
  249. 1.880932 240.739474
  250. 335.874939 .093396
  251. 1.523688 1.849736
  252. 49.480308 9.36
  253. -1.52 } { 11.863075
  254. 90.638185 14.170747
  255. .048482 5.202561
  256. 1.303613 100.353142
  257. 196.74 -9.4 } {
  258. 29.471362
  259. 287.690033
  260. 92.861407 .055581
  261. 9.554747 2.48898
  262. 113.576139 165.6
  263. -8.88 } { 84.039492
  264. 271.063148
  265. 172.884833 .046321
  266. 19.21814 .733059
  267. 73.926961 65.8
  268. -7.19 } { 164.79246
  269. 282.349556
  270. 48.009758 .009003
  271. 30.10957 1.770646
  272. 131.670599 62.2
  273. -6.87 } { 246.77027
  274. 221.4127 224.133
  275. .24624 39.3414
  276. 17.142 110.144 8.2
  277. -1 } }
  278. END
  279.